home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / calc202a.lha / calc-2.02a / calc-lang.el < prev    next >
Lisp/Scheme  |  1993-06-01  |  37KB  |  1,152 lines
  1. ;; Calculator for GNU Emacs, part II [calc-lang.el]
  2. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
  3. ;; Written by Dave Gillespie, daveg@synaptics.com.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23.  
  24. ;; This file is autoloaded from calc-ext.el.
  25. (require 'calc-ext)
  26.  
  27. (require 'calc-macs)
  28.  
  29. (defun calc-Need-calc-lang () nil)
  30.  
  31.  
  32. ;;; Alternate entry/display languages.
  33.  
  34. (defun calc-set-language (lang &optional option no-refresh)
  35.   (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
  36.     math-expr-function-mapping (get lang 'math-function-table)
  37.     math-expr-variable-mapping (get lang 'math-variable-table)
  38.     calc-language-input-filter (get lang 'math-input-filter)
  39.     calc-language-output-filter (get lang 'math-output-filter)
  40.     calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
  41.     calc-complex-format (get lang 'math-complex-format)
  42.     calc-radix-formatter (get lang 'math-radix-formatter)
  43.     calc-function-open (or (get lang 'math-function-open) "(")
  44.     calc-function-close (or (get lang 'math-function-close) ")"))
  45.   (if no-refresh
  46.       (setq calc-language lang
  47.         calc-language-option option)
  48.     (calc-change-mode '(calc-language calc-language-option)
  49.               (list lang option) t))
  50. )
  51.  
  52. (defun calc-normal-language ()
  53.   (interactive)
  54.   (calc-wrapper
  55.    (calc-set-language nil)
  56.    (message "Normal language mode."))
  57. )
  58.  
  59. (defun calc-flat-language ()
  60.   (interactive)
  61.   (calc-wrapper
  62.    (calc-set-language 'flat)
  63.    (message "Flat language mode (all stack entries shown on one line)."))
  64. )
  65.  
  66. (defun calc-big-language ()
  67.   (interactive)
  68.   (calc-wrapper
  69.    (calc-set-language 'big)
  70.    (message "\"Big\" language mode."))
  71. )
  72.  
  73. (defun calc-unformatted-language ()
  74.   (interactive)
  75.   (calc-wrapper
  76.    (calc-set-language 'unform)
  77.    (message "Unformatted language mode."))
  78. )
  79.  
  80.  
  81. (defun calc-c-language ()
  82.   (interactive)
  83.   (calc-wrapper
  84.    (calc-set-language 'c)
  85.    (message "`C' language mode."))
  86. )
  87.  
  88. (put 'c 'math-oper-table
  89.   '( ( "u+"    ident         -1 1000 )
  90.      ( "u-"    neg         -1 1000 )
  91.      ( "u!"    calcFunc-lnot -1 1000 )
  92.      ( "~"     calcFunc-not  -1 1000 )
  93.      ( "*"     *         190 191 )
  94.      ( "/"     /         190 191 )
  95.      ( "%"     %         190 191 )
  96.      ( "+"     +         180 181 )
  97.      ( "-"     -         180 181 )
  98.      ( "<<"    calcFunc-lsh  170 171 )
  99.      ( ">>"    calcFunc-rsh  170 171 )
  100.      ( "<"     calcFunc-lt   160 161 )
  101.      ( ">"     calcFunc-gt   160 161 )
  102.      ( "<="    calcFunc-leq  160 161 )
  103.      ( ">="    calcFunc-geq  160 161 )
  104.      ( "=="    calcFunc-eq   150 151 )
  105.      ( "!="    calcFunc-neq  150 151 )
  106.      ( "&"     calcFunc-and  140 141 )
  107.      ( "^"     calcFunc-xor  131 130 )
  108.      ( "|"     calcFunc-or   120 121 )
  109.      ( "&&"    calcFunc-land 110 111 )
  110.      ( "||"    calcFunc-lor  100 101 )
  111.      ( "?"     (math-read-if)  91  90 )
  112.      ( "!!!"   calcFunc-pnot  -1  88 )
  113.      ( "&&&"   calcFunc-pand  85  86 )
  114.      ( "|||"   calcFunc-por   75  76 )
  115.      ( "="     calcFunc-assign 51 50 )
  116.      ( ":="    calcFunc-assign 51 50 )
  117.      ( "::"    calcFunc-condition 45 46 )
  118. )) ; should support full assignments
  119.  
  120. (put 'c 'math-function-table
  121.   '( ( acos       . calcFunc-arccos )
  122.      ( acosh       . calcFunc-arccosh )
  123.      ( asin       . calcFunc-arcsin )
  124.      ( asinh       . calcFunc-arcsinh )
  125.      ( atan       . calcFunc-arctan )
  126.      ( atan2       . calcFunc-arctan2 )
  127.      ( atanh       . calcFunc-arctanh )
  128. ))
  129.  
  130. (put 'c 'math-variable-table
  131.   '( ( M_PI       . var-pi )
  132.      ( M_E       . var-e )
  133. ))
  134.  
  135. (put 'c 'math-vector-brackets "{}")
  136.  
  137. (put 'c 'math-radix-formatter
  138.      (function (lambda (r s)
  139.          (if (= r 16) (format "0x%s" s)
  140.            (if (= r 8) (format "0%s" s)
  141.              (format "%d#%s" r s))))))
  142.  
  143.  
  144. (defun calc-pascal-language (n)
  145.   (interactive "P")
  146.   (calc-wrapper
  147.    (and n (setq n (prefix-numeric-value n)))
  148.    (calc-set-language 'pascal n)
  149.    (message (if (and n (/= n 0))
  150.         (if (> n 0)
  151.             "Pascal language mode (all uppercase)."
  152.           "Pascal language mode (all lowercase).")
  153.           "Pascal language mode.")))
  154. )
  155.  
  156. (put 'pascal 'math-oper-table
  157.   '( ( "not"   calcFunc-lnot -1 1000 )
  158.      ( "*"     *         190 191 )
  159.      ( "/"     /         190 191 )
  160.      ( "and"   calcFunc-and  190 191 )
  161.      ( "div"   calcFunc-idiv 190 191 )
  162.      ( "mod"   %         190 191 )
  163.      ( "u+"    ident         -1  185 )
  164.      ( "u-"    neg         -1  185 )
  165.      ( "+"     +         180 181 )
  166.      ( "-"     -         180 181 )
  167.      ( "or"    calcFunc-or   180 181 )
  168.      ( "xor"   calcFunc-xor  180 181 )
  169.      ( "shl"   calcFunc-lsh  180 181 )
  170.      ( "shr"   calcFunc-rsh  180 181 )
  171.      ( "in"    calcFunc-in   160 161 )
  172.      ( "<"     calcFunc-lt   160 161 )
  173.      ( ">"     calcFunc-gt   160 161 )
  174.      ( "<="    calcFunc-leq  160 161 )
  175.      ( ">="    calcFunc-geq  160 161 )
  176.      ( "="     calcFunc-eq   160 161 )
  177.      ( "<>"    calcFunc-neq  160 161 )
  178.      ( "!!!"   calcFunc-pnot  -1  85 )
  179.      ( "&&&"   calcFunc-pand  80  81 )
  180.      ( "|||"   calcFunc-por   75  76 )
  181.      ( ":="    calcFunc-assign 51 50 )
  182.      ( "::"    calcFunc-condition 45 46 )
  183. ))
  184.  
  185. (put 'pascal 'math-input-filter 'calc-input-case-filter)
  186. (put 'pascal 'math-output-filter 'calc-output-case-filter)
  187.  
  188. (put 'pascal 'math-radix-formatter
  189.      (function (lambda (r s)
  190.          (if (= r 16) (format "$%s" s)
  191.            (format "%d#%s" r s)))))
  192.  
  193. (defun calc-input-case-filter (str)
  194.   (cond ((or (null calc-language-option) (= calc-language-option 0))
  195.      str)
  196.     (t
  197.      (downcase str)))
  198. )
  199.  
  200. (defun calc-output-case-filter (str)
  201.   (cond ((or (null calc-language-option) (= calc-language-option 0))
  202.      str)
  203.     ((> calc-language-option 0)
  204.      (upcase str))
  205.     (t
  206.      (downcase str)))
  207. )
  208.  
  209.  
  210. (defun calc-fortran-language (n)
  211.   (interactive "P")
  212.   (calc-wrapper
  213.    (and n (setq n (prefix-numeric-value n)))
  214.    (calc-set-language 'fortran n)
  215.    (message (if (and n (/= n 0))
  216.         (if (> n 0)
  217.             "FORTRAN language mode (all uppercase)."
  218.           "FORTRAN language mode (all lowercase).")
  219.           "FORTRAN language mode.")))
  220. )
  221.  
  222. (put 'fortran 'math-oper-table
  223.   '( ( "u/"    (math-parse-fortran-vector) -1 1 )
  224.      ( "/"     (math-parse-fortran-vector-end) 1 -1 )
  225.      ( "**"    ^             201 200 )
  226.      ( "u+"    ident         -1  191 )
  227.      ( "u-"    neg         -1  191 )
  228.      ( "*"     *         190 191 )
  229.      ( "/"     /         190 191 )
  230.      ( "+"     +         180 181 )
  231.      ( "-"     -         180 181 )
  232.      ( ".LT."  calcFunc-lt   160 161 )
  233.      ( ".GT."  calcFunc-gt   160 161 )
  234.      ( ".LE."  calcFunc-leq  160 161 )
  235.      ( ".GE."  calcFunc-geq  160 161 )
  236.      ( ".EQ."  calcFunc-eq   160 161 )
  237.      ( ".NE."  calcFunc-neq  160 161 )
  238.      ( ".NOT." calcFunc-lnot -1  121 )
  239.      ( ".AND." calcFunc-land 110 111 )
  240.      ( ".OR."  calcFunc-lor  100 101 )
  241.      ( "!!!"   calcFunc-pnot  -1  85 )
  242.      ( "&&&"   calcFunc-pand  80  81 )
  243.      ( "|||"   calcFunc-por   75  76 )
  244.      ( "="     calcFunc-assign 51 50 )
  245.      ( ":="    calcFunc-assign 51 50 )
  246.      ( "::"    calcFunc-condition 45 46 )
  247. ))
  248.  
  249. (put 'fortran 'math-vector-brackets "//")
  250.  
  251. (put 'fortran 'math-function-table
  252.   '( ( acos       . calcFunc-arccos )
  253.      ( acosh       . calcFunc-arccosh )
  254.      ( aimag       . calcFunc-im )
  255.      ( aint       . calcFunc-ftrunc )
  256.      ( asin       . calcFunc-arcsin )
  257.      ( asinh       . calcFunc-arcsinh )
  258.      ( atan       . calcFunc-arctan )
  259.      ( atan2       . calcFunc-arctan2 )
  260.      ( atanh       . calcFunc-arctanh )
  261.      ( conjg       . calcFunc-conj )
  262.      ( log       . calcFunc-ln )
  263.      ( nint       . calcFunc-round )
  264.      ( real       . calcFunc-re )
  265. ))
  266.  
  267. (put 'fortran 'math-input-filter 'calc-input-case-filter)
  268. (put 'fortran 'math-output-filter 'calc-output-case-filter)
  269.  
  270. (defun math-parse-fortran-vector (op)
  271.   (let ((math-parsing-fortran-vector '(end . "\000")))
  272.     (prog1
  273.     (math-read-brackets t "]")
  274.       (setq exp-token (car math-parsing-fortran-vector)
  275.         exp-data (cdr math-parsing-fortran-vector))))
  276. )
  277.  
  278. (defun math-parse-fortran-vector-end (x op)
  279.   (if math-parsing-fortran-vector
  280.       (progn
  281.     (setq math-parsing-fortran-vector (cons exp-token exp-data)
  282.           exp-token 'end
  283.           exp-data "\000")
  284.     x)
  285.     (throw 'syntax "Unmatched closing `/'"))
  286. )
  287. (setq math-parsing-fortran-vector nil)
  288.  
  289. (defun math-parse-fortran-subscr (sym args)
  290.   (setq sym (math-build-var-name sym))
  291.   (while args
  292.     (setq sym (list 'calcFunc-subscr sym (car args))
  293.       args (cdr args)))
  294.   sym
  295. )
  296.  
  297.  
  298. (defun calc-tex-language (n)
  299.   (interactive "P")
  300.   (calc-wrapper
  301.    (and n (setq n (prefix-numeric-value n)))
  302.    (calc-set-language 'tex n)
  303.    (message (if (and n (/= n 0))
  304.         (if (> n 0)
  305.             "TeX language mode with \\hbox{func}(\\hbox{var})."
  306.           "TeX language mode with \\func{\\hbox{var}}.")
  307.           "TeX language mode.")))
  308. )
  309.  
  310. (put 'tex 'math-oper-table
  311.   '( ( "u+"       ident           -1 1000 )
  312.      ( "u-"       neg           -1 1000 )
  313.      ( "\\hat"    calcFunc-hat     -1  950 )
  314.      ( "\\check"  calcFunc-check   -1  950 )
  315.      ( "\\tilde"  calcFunc-tilde   -1  950 )
  316.      ( "\\acute"  calcFunc-acute   -1  950 )
  317.      ( "\\grave"  calcFunc-grave   -1  950 )
  318.      ( "\\dot"    calcFunc-dot     -1  950 )
  319.      ( "\\ddot"   calcFunc-dotdot  -1  950 )
  320.      ( "\\breve"  calcFunc-breve   -1  950 )
  321.      ( "\\bar"    calcFunc-bar     -1  950 )
  322.      ( "\\vec"    calcFunc-Vec     -1  950 )
  323.      ( "\\underline" calcFunc-under -1  950 )
  324.      ( "u|"       calcFunc-abs       -1    0 )
  325.      ( "|"        closing        0   -1 )
  326.      ( "\\lfloor" calcFunc-floor   -1    0 )
  327.      ( "\\rfloor" closing           0   -1 )
  328.      ( "\\lceil"  calcFunc-ceil    -1    0 )
  329.      ( "\\rceil"  closing           0   -1 )
  330.      ( "\\pm"      sdev           300 300 )
  331.      ( "!"        calcFunc-fact       210  -1 )
  332.      ( "^"      ^           201 200 )
  333.      ( "_"      calcFunc-subscr  201 200 )
  334.      ( "\\times"  *           191 190 )
  335.      ( "*"        *           191 190 )
  336.      ( "2x"      *           191 190 )
  337.      ( "+"      +           180 181 )
  338.      ( "-"      -           180 181 )
  339.      ( "\\over"      /           170 171 )
  340.      ( "/"      /           170 171 )
  341.      ( "\\choose" calcFunc-choose  170 171 )
  342.      ( "\\mod"      %           170 171 )
  343.      ( "<"      calcFunc-lt       160 161 )
  344.      ( ">"      calcFunc-gt       160 161 )
  345.      ( "\\leq"      calcFunc-leq       160 161 )
  346.      ( "\\geq"      calcFunc-geq       160 161 )
  347.      ( "="      calcFunc-eq       160 161 )
  348.      ( "\\neq"      calcFunc-neq       160 161 )
  349.      ( "\\ne"      calcFunc-neq       160 161 )
  350.      ( "\\lnot"   calcFunc-lnot     -1 121 )
  351.      ( "\\land"      calcFunc-land    110 111 )
  352.      ( "\\lor"      calcFunc-lor     100 101 )
  353.      ( "?"      (math-read-if)    91  90 )
  354.      ( "!!!"      calcFunc-pnot        -1  85 )
  355.      ( "&&&"      calcFunc-pand        80  81 )
  356.      ( "|||"      calcFunc-por        75  76 )
  357.      ( "\\gets"      calcFunc-assign   51  50 )
  358.      ( ":="      calcFunc-assign   51  50 )
  359.      ( "::"       calcFunc-condition 45 46 )
  360.      ( "\\to"      calcFunc-evalto   40  41 )
  361.      ( "\\to"      calcFunc-evalto   40  -1 )
  362.      ( "=>"       calcFunc-evalto   40  41 )
  363.      ( "=>"       calcFunc-evalto   40  -1 )
  364. ))
  365.  
  366. (put 'tex 'math-function-table
  367.   '( ( \\arccos       . calcFunc-arccos )
  368.      ( \\arcsin       . calcFunc-arcsin )
  369.      ( \\arctan       . calcFunc-arctan )
  370.      ( \\arg       . calcFunc-arg )
  371.      ( \\cos       . calcFunc-cos )
  372.      ( \\cosh       . calcFunc-cosh )
  373.      ( \\det       . calcFunc-det )
  374.      ( \\exp       . calcFunc-exp )
  375.      ( \\gcd       . calcFunc-gcd )
  376.      ( \\ln       . calcFunc-ln )
  377.      ( \\log       . calcFunc-log10 )
  378.      ( \\max       . calcFunc-max )
  379.      ( \\min       . calcFunc-min )
  380.      ( \\tan       . calcFunc-tan )
  381.      ( \\sin       . calcFunc-sin )
  382.      ( \\sinh       . calcFunc-sinh )
  383.      ( \\sqrt       . calcFunc-sqrt )
  384.      ( \\tanh       . calcFunc-tanh )
  385.      ( \\phi       . calcFunc-totient )
  386.      ( \\mu       . calcFunc-moebius )
  387. ))
  388.  
  389. (put 'tex 'math-variable-table
  390.   '( ( \\pi       . var-pi )
  391.      ( \\infty       . var-inf )
  392.      ( \\infty       . var-uinf )
  393.      ( \\phi       . var-phi )
  394.      ( \\gamma     . var-gamma )
  395.      ( \\sum       . (math-parse-tex-sum calcFunc-sum) )
  396.      ( \\prod      . (math-parse-tex-sum calcFunc-prod) )
  397. ))
  398.  
  399. (put 'tex 'math-complex-format 'i)
  400.  
  401. (defun math-parse-tex-sum (f val)
  402.   (let (low high save)
  403.     (or (equal exp-data "_") (throw 'syntax "Expected `_'"))
  404.     (math-read-token)
  405.     (setq save exp-old-pos)
  406.     (setq low (math-read-factor))
  407.     (or (eq (car-safe low) 'calcFunc-eq)
  408.     (progn
  409.       (setq exp-old-pos (1+ save))
  410.       (throw 'syntax "Expected equation")))
  411.     (or (equal exp-data "^") (throw 'syntax "Expected `^'"))
  412.     (math-read-token)
  413.     (setq high (math-read-factor))
  414.     (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))
  415. )
  416.  
  417. (defun math-tex-input-filter (str)   ; allow parsing of 123\,456\,789.
  418.   (while (string-match "[0-9]\\\\,[0-9]" str)
  419.     (setq str (concat (substring str 0 (1+ (match-beginning 0)))
  420.               (substring str (1- (match-end 0))))))
  421.   str
  422. )
  423. (put 'tex 'math-input-filter 'math-tex-input-filter)
  424.  
  425.  
  426. (defun calc-eqn-language (n)
  427.   (interactive "P")
  428.   (calc-wrapper
  429.    (calc-set-language 'eqn)
  430.    (message "Eqn language mode."))
  431. )
  432.  
  433. (put 'eqn 'math-oper-table
  434.   '( ( "u+"       ident           -1 1000 )
  435.      ( "u-"       neg           -1 1000 )
  436.      ( "prime"    (math-parse-eqn-prime) 950  -1 )
  437.      ( "prime"    calcFunc-Prime   950  -1 )
  438.      ( "dot"      calcFunc-dot     950  -1 )
  439.      ( "dotdot"   calcFunc-dotdot  950  -1 )
  440.      ( "hat"      calcFunc-hat     950  -1 )
  441.      ( "tilde"    calcFunc-tilde   950  -1 )
  442.      ( "vec"      calcFunc-Vec     950  -1 )
  443.      ( "dyad"     calcFunc-dyad    950  -1 )
  444.      ( "bar"      calcFunc-bar     950  -1 )
  445.      ( "under"    calcFunc-under   950  -1 )
  446.      ( "sub"      calcFunc-subscr  931 930 )
  447.      ( "sup"      ^           921 920 )
  448.      ( "sqrt"      calcFunc-sqrt    -1  910 )
  449.      ( "over"      /           900 901 )
  450.      ( "u|"       calcFunc-abs       -1    0 )
  451.      ( "|"        closing        0   -1 )
  452.      ( "left floor"  calcFunc-floor -1   0 )
  453.      ( "right floor" closing        0   -1 )
  454.      ( "left ceil"   calcFunc-ceil  -1   0 )
  455.      ( "right ceil"  closing        0   -1 )
  456.      ( "+-"      sdev           300 300 )
  457.      ( "!"        calcFunc-fact       210  -1 )
  458.      ( "times"    *           191 190 )
  459.      ( "*"        *           191 190 )
  460.      ( "2x"      *           191 190 )
  461.      ( "/"      /           180 181 )
  462.      ( "%"      %           180 181 )
  463.      ( "+"      +           170 171 )
  464.      ( "-"      -           170 171 )
  465.      ( "<"      calcFunc-lt       160 161 )
  466.      ( ">"      calcFunc-gt       160 161 )
  467.      ( "<="      calcFunc-leq       160 161 )
  468.      ( ">="      calcFunc-geq       160 161 )
  469.      ( "="      calcFunc-eq       160 161 )
  470.      ( "=="      calcFunc-eq       160 161 )
  471.      ( "!="      calcFunc-neq       160 161 )
  472.      ( "u!"       calcFunc-lnot     -1 121 )
  473.      ( "&&"      calcFunc-land    110 111 )
  474.      ( "||"      calcFunc-lor     100 101 )
  475.      ( "?"      (math-read-if)    91  90 )
  476.      ( "!!!"      calcFunc-pnot        -1  85 )
  477.      ( "&&&"      calcFunc-pand        80  81 )
  478.      ( "|||"      calcFunc-por        75  76 )
  479.      ( "<-"      calcFunc-assign   51  50 )
  480.      ( ":="      calcFunc-assign   51  50 )
  481.      ( "::"      calcFunc-condition 45 46 )
  482.      ( "->"      calcFunc-evalto   40  41 )
  483.      ( "->"      calcFunc-evalto   40  -1 )
  484.      ( "=>"       calcFunc-evalto   40  41 )
  485.      ( "=>"       calcFunc-evalto   40  -1 )
  486. ))
  487.  
  488. (put 'eqn 'math-function-table
  489.   '( ( arc\ cos       . calcFunc-arccos )
  490.      ( arc\ cosh   . calcFunc-arccosh )
  491.      ( arc\ sin       . calcFunc-arcsin )
  492.      ( arc\ sinh   . calcFunc-arcsinh )
  493.      ( arc\ tan       . calcFunc-arctan )
  494.      ( arc\ tanh   . calcFunc-arctanh )
  495.      ( GAMMA       . calcFunc-gamma )
  496.      ( phi       . calcFunc-totient )
  497.      ( mu       . calcFunc-moebius )
  498.      ( matrix       . (math-parse-eqn-matrix) )
  499. ))
  500.  
  501. (put 'eqn 'math-variable-table
  502.   '( ( inf       . var-uinf )
  503. ))
  504.  
  505. (put 'eqn 'math-complex-format 'i)
  506.  
  507. (defun math-parse-eqn-matrix (f sym)
  508.   (let ((vec nil))
  509.     (while (assoc exp-data '(("ccol") ("lcol") ("rcol")))
  510.       (math-read-token)
  511.       (or (equal exp-data calc-function-open)
  512.       (throw 'syntax "Expected `{'"))
  513.       (math-read-token)
  514.       (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
  515.       (or (equal exp-data calc-function-close)
  516.       (throw 'syntax "Expected `}'"))
  517.       (math-read-token))
  518.     (or (equal exp-data calc-function-close)
  519.     (throw 'syntax "Expected `}'"))
  520.     (math-read-token)
  521.     (math-transpose (cons 'vec (nreverse vec))))
  522. )
  523.  
  524. (defun math-parse-eqn-prime (x sym)
  525.   (if (eq (car-safe x) 'var)
  526.       (if (equal exp-data calc-function-open)
  527.       (progn
  528.         (math-read-token)
  529.         (let ((args (if (or (equal exp-data calc-function-close)
  530.                 (eq exp-token 'end))
  531.                 nil
  532.               (math-read-expr-list))))
  533.           (if (not (or (equal exp-data calc-function-close)
  534.                (eq exp-token 'end)))
  535.           (throw 'syntax "Expected `)'"))
  536.           (math-read-token)
  537.           (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
  538.     (list 'var
  539.           (intern (concat (symbol-name (nth 1 x)) "'"))
  540.           (intern (concat (symbol-name (nth 2 x)) "'"))))
  541.     (list 'calcFunc-Prime x))
  542. )
  543.  
  544.  
  545. (defun calc-mathematica-language ()
  546.   (interactive)
  547.   (calc-wrapper
  548.    (calc-set-language 'math)
  549.    (message "Mathematica language mode."))
  550. )
  551.  
  552. (put 'math 'math-oper-table
  553.   '( ( "[["    (math-read-math-subscr) 250 -1 )
  554.      ( "!"     calcFunc-fact  210 -1 )
  555.      ( "!!"    calcFunc-dfact 210 -1 )
  556.      ( "^"     ^         201 200 )
  557.      ( "u+"    ident         -1  197 )
  558.      ( "u-"    neg         -1  197 )
  559.      ( "/"     /         195 196 )
  560.      ( "*"     *         190 191 )
  561.      ( "2x"    *         190 191 )
  562.      ( "+"     +         180 181 )
  563.      ( "-"     -         180 181 )
  564.      ( "<"     calcFunc-lt   160 161 )
  565.      ( ">"     calcFunc-gt   160 161 )
  566.      ( "<="    calcFunc-leq  160 161 )
  567.      ( ">="    calcFunc-geq  160 161 )
  568.      ( "=="    calcFunc-eq   150 151 )
  569.      ( "!="    calcFunc-neq  150 151 )
  570.      ( "u!"    calcFunc-lnot -1  121 )
  571.      ( "&&"    calcFunc-land 110 111 )
  572.      ( "||"    calcFunc-lor  100 101 )
  573.      ( "!!!"   calcFunc-pnot  -1  85 )
  574.      ( "&&&"   calcFunc-pand  80  81 )
  575.      ( "|||"   calcFunc-por   75  76 )
  576.      ( ":="    calcFunc-assign 51 50 )
  577.      ( "="     calcFunc-assign 51 50 )
  578.      ( "->"    calcFunc-assign 51 50 )
  579.      ( ":>"    calcFunc-assign 51 50 )
  580.      ( "::"    calcFunc-condition 45 46 )
  581. ))
  582.  
  583. (put 'math 'math-function-table
  584.   '( ( Abs       . calcFunc-abs )
  585.      ( ArcCos       . calcFunc-arccos )
  586.      ( ArcCosh       . calcFunc-arccosh )
  587.      ( ArcSin       . calcFunc-arcsin )
  588.      ( ArcSinh       . calcFunc-arcsinh )
  589.      ( ArcTan       . calcFunc-arctan )
  590.      ( ArcTanh       . calcFunc-arctanh )
  591.      ( Arg       . calcFunc-arg )
  592.      ( Binomial       . calcFunc-choose )
  593.      ( Ceiling       . calcFunc-ceil )
  594.      ( Conjugate   . calcFunc-conj )
  595.      ( Cos       . calcFunc-cos )
  596.      ( Cosh       . calcFunc-cosh )
  597.      ( D       . calcFunc-deriv )
  598.      ( Dt       . calcFunc-tderiv )
  599.      ( Det       . calcFunc-det )
  600.      ( Exp       . calcFunc-exp )
  601.      ( EulerPhi       . calcFunc-totient )
  602.      ( Floor       . calcFunc-floor )
  603.      ( Gamma       . calcFunc-gamma )
  604.      ( GCD       . calcFunc-gcd )
  605.      ( If       . calcFunc-if )
  606.      ( Im       . calcFunc-im )
  607.      ( Inverse       . calcFunc-inv )
  608.      ( Integrate   . calcFunc-integ )
  609.      ( Join       . calcFunc-vconcat )
  610.      ( LCM       . calcFunc-lcm )
  611.      ( Log       . calcFunc-ln )
  612.      ( Max       . calcFunc-max )
  613.      ( Min       . calcFunc-min )
  614.      ( Mod       . calcFunc-mod )
  615.      ( MoebiusMu   . calcFunc-moebius )
  616.      ( Random       . calcFunc-random )
  617.      ( Round       . calcFunc-round )
  618.      ( Re       . calcFunc-re )
  619.      ( Sign       . calcFunc-sign )
  620.      ( Sin       . calcFunc-sin )
  621.      ( Sinh       . calcFunc-sinh )
  622.      ( Sqrt       . calcFunc-sqrt )
  623.      ( Tan       . calcFunc-tan )
  624.      ( Tanh       . calcFunc-tanh )
  625.      ( Transpose   . calcFunc-trn )
  626.      ( Length       . calcFunc-vlen )
  627. ))
  628.  
  629. (put 'math 'math-variable-table
  630.   '( ( I       . var-i )
  631.      ( Pi       . var-pi )
  632.      ( E       . var-e )
  633.      ( GoldenRatio . var-phi )
  634.      ( EulerGamma  . var-gamma )
  635.      ( Infinity       . var-inf )
  636.      ( ComplexInfinity . var-uinf )
  637.      ( Indeterminate . var-nan )
  638. ))
  639.  
  640. (put 'math 'math-vector-brackets "{}")
  641. (put 'math 'math-complex-format 'I)
  642. (put 'math 'math-function-open "[")
  643. (put 'math 'math-function-close "]")
  644.  
  645. (put 'math 'math-radix-formatter
  646.      (function (lambda (r s) (format "%d^^%s" r s))))
  647.  
  648. (defun math-read-math-subscr (x op)
  649.   (let ((idx (math-read-expr-level 0)))
  650.     (or (and (equal exp-data "]")
  651.          (progn
  652.            (math-read-token)
  653.            (equal exp-data "]")))
  654.     (throw 'syntax "Expected ']]'"))
  655.     (math-read-token)
  656.     (list 'calcFunc-subscr x idx))
  657. )
  658.  
  659.  
  660. (defun calc-maple-language ()
  661.   (interactive)
  662.   (calc-wrapper
  663.    (calc-set-language 'maple)
  664.    (message "Maple language mode."))
  665. )
  666.  
  667. (put 'maple 'math-oper-table
  668.   '( ( "matrix" ident         -1  300 )
  669.      ( "MATRIX" ident         -1  300 )
  670.      ( "!"     calcFunc-fact  210 -1 )
  671.      ( "^"     ^         201 200 )
  672.      ( "**"    ^         201 200 )
  673.      ( "u+"    ident         -1  197 )
  674.      ( "u-"    neg         -1  197 )
  675.      ( "/"     /         191 192 )
  676.      ( "*"     *         191 192 )
  677.      ( "intersect" calcFunc-vint 191 192 )
  678.      ( "+"     +         180 181 )
  679.      ( "-"     -         180 181 )
  680.      ( "union" calcFunc-vunion 180 181 )
  681.      ( "minus" calcFunc-vdiff 180 181 )
  682.      ( "mod"   %         170 170 )
  683.      ( ".."    (math-read-maple-dots) 165 165 )
  684.      ( "\\dots" (math-read-maple-dots) 165 165 )
  685.      ( "<"     calcFunc-lt   160 160 )
  686.      ( ">"     calcFunc-gt   160 160 )
  687.      ( "<="    calcFunc-leq  160 160 )
  688.      ( ">="    calcFunc-geq  160 160 )
  689.      ( "="     calcFunc-eq   160 160 )
  690.      ( "<>"    calcFunc-neq  160 160 )
  691.      ( "not"   calcFunc-lnot -1  121 )
  692.      ( "and"   calcFunc-land 110 111 )
  693.      ( "or"    calcFunc-lor  100 101 )
  694.      ( "!!!"   calcFunc-pnot  -1  85 )
  695.      ( "&&&"   calcFunc-pand  80  81 )
  696.      ( "|||"   calcFunc-por   75  76 )
  697.      ( ":="    calcFunc-assign 51 50 )
  698.      ( "::"    calcFunc-condition 45 46 )
  699. ))
  700.  
  701. (put 'maple 'math-function-table
  702.   '( ( bernoulli   . calcFunc-bern )
  703.      ( binomial       . calcFunc-choose )
  704.      ( diff       . calcFunc-deriv )
  705.      ( GAMMA       . calcFunc-gamma )
  706.      ( ifactor       . calcFunc-prfac )
  707.      ( igcd        . calcFunc-gcd )
  708.      ( ilcm       . calcFunc-lcm )
  709.      ( int         . calcFunc-integ )
  710.      ( modp       . % )
  711.      ( irem       . % )
  712.      ( iquo       . calcFunc-idiv )
  713.      ( isprime       . calcFunc-prime )
  714.      ( length       . calcFunc-vlen )
  715.      ( member       . calcFunc-in )
  716.      ( crossprod   . calcFunc-cross )
  717.      ( inverse       . calcFunc-inv )
  718.      ( trace       . calcFunc-tr )
  719.      ( transpose   . calcFunc-trn )
  720.      ( vectdim       . calcFunc-vlen )
  721. ))
  722.  
  723. (put 'maple 'math-variable-table
  724.   '( ( I       . var-i )
  725.      ( Pi       . var-pi )
  726.      ( E       . var-e )
  727.      ( infinity       . var-inf )
  728.      ( infinity    . var-uinf )
  729.      ( infinity    . var-nan )
  730. ))
  731.  
  732. (put 'maple 'math-complex-format 'I)
  733.  
  734. (defun math-read-maple-dots (x op)
  735.   (list 'intv 3 x (math-read-expr-level (nth 3 op)))
  736. )
  737.  
  738.  
  739.  
  740.  
  741.  
  742. (defun math-read-big-rec (h1 v1 h2 v2 &optional baseline prec short)
  743.   (or prec (setq prec 0))
  744.  
  745.   ;; Clip whitespace above or below.
  746.   (while (and (< v1 v2) (math-read-big-emptyp h1 v1 h2 (1+ v1)))
  747.     (setq v1 (1+ v1)))
  748.   (while (and (< v1 v2) (math-read-big-emptyp h1 (1- v2) h2 v2))
  749.     (setq v2 (1- v2)))
  750.  
  751.   ;; If formula is a single line high, normal parser can handle it.
  752.   (if (<= v2 (1+ v1))
  753.       (if (or (<= v2 v1)
  754.           (> h1 (length (setq v2 (nth v1 lines)))))
  755.       (math-read-big-error h1 v1)
  756.     (setq the-baseline v1
  757.           the-h2 h2
  758.           v2 (nth v1 lines)
  759.           h2 (math-read-expr (substring v2 h1 (min h2 (length v2)))))
  760.     (if (eq (car-safe h2) 'error)
  761.         (math-read-big-error (+ h1 (nth 1 h2)) v1 (nth 2 h2))
  762.       h2))
  763.  
  764.     ;; Clip whitespace at left or right.
  765.     (while (and (< h1 h2) (math-read-big-emptyp h1 v1 (1+ h1) v2))
  766.       (setq h1 (1+ h1)))
  767.     (while (and (< h1 h2) (math-read-big-emptyp (1- h2) v1 h2 v2))
  768.       (setq h2 (1- h2)))
  769.  
  770.     ;; Scan to find widest left-justified "----" in the region.
  771.     (let* ((widest nil)
  772.        (widest-h2 0)
  773.        (lines-v1 (nthcdr v1 lines))
  774.        (p lines-v1)
  775.        (v v1)
  776.        (other-v nil)
  777.        other-char line len h)
  778.       (while (< v v2)
  779.     (setq line (car p)
  780.           len (min h2 (length line)))
  781.     (and (< h1 len)
  782.          (/= (aref line h1) ?\ )
  783.          (if (and (= (aref line h1) ?\-)
  784.               ;; Make sure it's not a minus sign.
  785.               (or (and (< (1+ h1) len) (= (aref line (1+ h1)) ?\-))
  786.               (/= (math-read-big-char h1 (1- v)) ?\ )
  787.               (/= (math-read-big-char h1 (1+ v)) ?\ )))
  788.          (progn
  789.            (setq h h1)
  790.            (while (and (< (setq h (1+ h)) len)
  791.                    (= (aref line h) ?\-)))
  792.            (if (> h widest-h2)
  793.                (setq widest v
  794.                  widest-h2 h)))
  795.            (or other-v (setq other-v v other-char (aref line h1)))))
  796.     (setq v (1+ v)
  797.           p (cdr p)))
  798.  
  799.       (cond ((not (setq v other-v))
  800.          (math-read-big-error h1 v1))   ; Should never happen!
  801.  
  802.         ;; Quotient.
  803.         (widest
  804.          (setq h widest-h2
  805.            v widest)
  806.          (let ((num (math-read-big-rec h1 v1 h v))
  807.            (den (math-read-big-rec h1 (1+ v) h v2)))
  808.            (setq p (if (and (math-integerp num) (math-integerp den))
  809.                (math-make-frac num den)
  810.              (list '/ num den)))))
  811.  
  812.         ;; Big radical sign.
  813.         ((= other-char ?\\)
  814.          (or (= (math-read-big-char (1+ h1) v) ?\|)
  815.          (math-read-big-error (1+ h1) v "Malformed root sign"))
  816.          (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
  817.          (while (= (math-read-big-char (1+ h1) (setq v (1- v))) ?\|))
  818.          (or (= (math-read-big-char (setq h (+ h1 2)) v) ?\_)
  819.          (math-read-big-error h v "Malformed root sign"))
  820.          (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
  821.          (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
  822.          (math-read-big-emptyp h1 (1+ other-v) h v2 nil t)
  823.          (setq p (list 'calcFunc-sqrt (math-read-big-rec
  824.                        (+ h1 2) (1+ v)
  825.                        h (1+ other-v) baseline))
  826.            v the-baseline))
  827.  
  828.         ;; Small radical sign.
  829.         ((and (= other-char ?V)
  830.           (= (math-read-big-char (1+ h1) (1- v)) ?\_))
  831.          (setq h (1+ h1))
  832.          (math-read-big-emptyp h1 v1 h (1- v) nil t)
  833.          (math-read-big-emptyp h1 (1+ v) h v2 nil t)
  834.          (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
  835.          (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
  836.          (setq p (list 'calcFunc-sqrt (math-read-big-rec
  837.                        (1+ h1) v h (1+ v) t))
  838.            v the-baseline))
  839.  
  840.         ;; Binomial coefficient.
  841.         ((and (= other-char ?\()
  842.           (= (math-read-big-char (1+ h1) v) ?\ )
  843.           (= (string-match "( *)" (nth v lines) h1) h1))
  844.          (setq h (match-end 0))
  845.          (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
  846.          (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
  847.          (math-read-big-emptyp (1- h) v1 h v nil t)
  848.          (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
  849.          (setq p (list 'calcFunc-choose
  850.                (math-read-big-rec (1+ h1) v1 (1- h) v)
  851.                (math-read-big-rec (1+ h1) (1+ v)
  852.                           (1- h) v2))))
  853.  
  854.         ;; Minus sign.
  855.         ((= other-char ?\-)
  856.          (setq p (list 'neg (math-read-big-rec (1+ h1) v1 h2 v2 v 250 t))
  857.            v the-baseline
  858.            h the-h2))
  859.  
  860.         ;; Parentheses.
  861.         ((= other-char ?\()
  862.          (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
  863.          (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
  864.          (setq h (math-read-big-balance (1+ h1) v "(" t))
  865.          (math-read-big-emptyp (1- h) v1 h v nil t)
  866.          (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
  867.          (let ((sep (math-read-big-char (1- h) v))
  868.            hmid)
  869.            (if (= sep ?\.)
  870.            (setq h (1+ h)))
  871.            (if (= sep ?\])
  872.            (math-read-big-error (1- h) v "Expected `)'"))
  873.            (if (= sep ?\))
  874.            (setq p (math-read-big-rec (1+ h1) v1 (1- h) v2 v))
  875.          (setq hmid (math-read-big-balance h v "(")
  876.                p (list p (math-read-big-rec h v1 (1- hmid) v2 v))
  877.                h hmid)
  878.          (cond ((= sep ?\.)
  879.             (setq p (cons 'intv (cons (if (= (math-read-big-char
  880.                               (1- h) v)
  881.                              ?\))
  882.                               0 1)
  883.                           p))))
  884.                ((= (math-read-big-char (1- h) v) ?\])
  885.             (math-read-big-error (1- h) v "Expected `)'"))
  886.                ((= sep ?\,)
  887.             (or (and (math-realp (car p)) (math-realp (nth 1 p)))
  888.                 (math-read-big-error
  889.                  h1 v "Complex components must be real"))
  890.             (setq p (cons 'cplx p)))
  891.                ((= sep ?\;)
  892.             (or (and (math-realp (car p)) (math-anglep (nth 1 p)))
  893.                 (math-read-big-error
  894.                  h1 v "Complex components must be real"))
  895.             (setq p (cons 'polar p)))))))
  896.  
  897.         ;; Matrix.
  898.         ((and (= other-char ?\[)
  899.           (or (= (math-read-big-char (setq h h1) (1+ v)) ?\[)
  900.               (= (math-read-big-char (setq h (1+ h)) v) ?\[)
  901.               (and (= (math-read-big-char h v) ?\ )
  902.                (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
  903.           (= (math-read-big-char h (1+ v)) ?\[))
  904.          (math-read-big-emptyp h1 v1 h v nil t)
  905.          (let ((vtop v)
  906.            (hleft h)
  907.            (hright nil))
  908.            (setq p nil)
  909.            (while (progn
  910.             (setq h (math-read-big-balance (1+ hleft) v "["))
  911.             (if hright
  912.                 (or (= h hright)
  913.                 (math-read-big-error hright v "Expected `]'"))
  914.               (setq hright h))
  915.             (setq p (cons (math-read-big-rec
  916.                        hleft v h (1+ v)) p))
  917.             (and (memq (math-read-big-char h v) '(?\  ?\,))
  918.                  (= (math-read-big-char hleft (1+ v)) ?\[)))
  919.          (setq v (1+ v)))
  920.            (or (= hleft h1)
  921.            (progn
  922.              (if (= (math-read-big-char h v) ?\ )
  923.              (setq h (1+ h)))
  924.              (and (= (math-read-big-char h v) ?\])
  925.               (setq h (1+ h))))
  926.            (math-read-big-error (1- h) v "Expected `]'"))
  927.            (if (= (math-read-big-char h vtop) ?\,)
  928.            (setq h (1+ h)))
  929.            (math-read-big-emptyp h1 (1+ v) (1- h) v2 nil t)
  930.            (setq v (+ vtop (/ (- v vtop) 2))
  931.              p (cons 'vec (nreverse p)))))
  932.  
  933.         ;; Square brackets.
  934.         ((= other-char ?\[)
  935.          (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
  936.          (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
  937.          (setq p nil
  938.            h (1+ h1))
  939.          (while (progn
  940.               (setq widest (math-read-big-balance h v "[" t))
  941.               (math-read-big-emptyp (1- h) v1 h v nil t)
  942.               (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
  943.               (setq p (cons (math-read-big-rec
  944.                      h v1 (1- widest) v2 v) p)
  945.                 h widest)
  946.               (= (math-read-big-char (1- h) v) ?\,)))
  947.          (setq widest (math-read-big-char (1- h) v))
  948.          (if (or (memq widest '(?\; ?\)))
  949.              (and (eq widest ?\.) (cdr p)))
  950.          (math-read-big-error (1- h) v "Expected `]'"))
  951.          (if (= widest ?\.)
  952.          (setq h (1+ h)
  953.                widest (math-read-big-balance h v "[")
  954.                p (nconc p (list (math-read-big-big-rec
  955.                      h v1 (1- widest) v2 v)))
  956.                h widest
  957.                p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
  958.                           ?\])
  959.                            3 2)
  960.                        p)))
  961.            (setq p (cons 'vec (nreverse p)))))
  962.  
  963.         ;; Date form.
  964.         ((= other-char ?\<)
  965.          (setq line (nth v lines))
  966.          (string-match ">" line h1)
  967.          (setq h (match-end 0))
  968.          (math-read-big-emptyp h1 v1 h v nil t)
  969.          (math-read-big-emptyp h1 (1+ v) h v2 nil t)
  970.          (setq p (math-read-big-rec h1 v h (1+ v) v)))
  971.  
  972.         ;; Variable name or function call.
  973.         ((or (and (>= other-char ?a) (<= other-char ?z))
  974.          (and (>= other-char ?A) (<= other-char ?Z)))
  975.          (setq line (nth v lines))
  976.          (string-match "\\([a-zA-Z'_]+\\) *" line h1)
  977.          (setq h (match-end 1)
  978.            widest (match-end 0)
  979.            p (math-match-substring line 1))
  980.          (math-read-big-emptyp h1 v1 h v nil t)
  981.          (math-read-big-emptyp h1 (1+ v) h v2 nil t)
  982.          (if (= (math-read-big-char widest v) ?\()
  983.          (progn
  984.            (setq line (if (string-match "-" p)
  985.                   (intern p)
  986.                 (intern (concat "calcFunc-" p)))
  987.              h (1+ widest)
  988.              p nil)
  989.            (math-read-big-emptyp widest v1 h v nil t)
  990.            (math-read-big-emptyp widest (1+ v) h v2 nil t)
  991.            (while (progn
  992.                 (setq widest (math-read-big-balance h v "(" t))
  993.                 (math-read-big-emptyp (1- h) v1 h v nil t)
  994.                 (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
  995.                 (setq p (cons (math-read-big-rec
  996.                        h v1 (1- widest) v2 v) p)
  997.                   h widest)
  998.                 (= (math-read-big-char (1- h) v) ?\,)))
  999.            (or (= (math-read-big-char (1- h) v) ?\))
  1000.                (math-read-big-error (1- h) v "Expected `)'"))
  1001.            (setq p (cons line (nreverse p))))
  1002.            (setq p (list 'var
  1003.                  (intern (math-remove-dashes p))
  1004.                  (if (string-match "-" p)
  1005.                  (intern p)
  1006.                    (intern (concat "var-" p)))))))
  1007.  
  1008.         ;; Number.
  1009.         (t
  1010.          (setq line (nth v lines))
  1011.          (or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line h1) h1)
  1012.          (math-read-big-error h v "Expected a number"))
  1013.          (setq h (match-end 0)
  1014.            p (math-read-number (math-match-substring line 0)))
  1015.          (math-read-big-emptyp h1 v1 h v nil t)
  1016.          (math-read-big-emptyp h1 (1+ v) h v2 nil t)))
  1017.  
  1018.       ;; Now left term is bounded by h1, v1, h, v2; baseline = v.
  1019.       (if baseline
  1020.       (or (= v baseline)
  1021.           (math-read-big-error h1 v "Inconsistent baseline in formula"))
  1022.     (setq baseline v))
  1023.  
  1024.       ;; Look for superscripts or subscripts.
  1025.       (setq line (nth baseline lines)
  1026.         len (min h2 (length line))
  1027.         widest h)
  1028.       (while (and (< widest len)
  1029.           (= (aref line widest) ?\ ))
  1030.     (setq widest (1+ widest)))
  1031.       (and (>= widest len) (setq widest h2))
  1032.       (if (math-read-big-emptyp h v widest v2)
  1033.       (if (math-read-big-emptyp h v1 widest v)
  1034.           (setq h widest)
  1035.         (setq p (list '^ p (math-read-big-rec h v1 widest v))
  1036.           h widest))
  1037.       (if (math-read-big-emptyp h v1 widest v)
  1038.           (setq p (list 'calcFunc-subscr p
  1039.                 (math-read-big-rec h v widest v2))
  1040.             h widest)))
  1041.  
  1042.       ;; Look for an operator name and grab additional terms.
  1043.       (while (and (< h len)
  1044.           (if (setq widest (and (math-read-big-emptyp
  1045.                      h v1 (1+ h) v)
  1046.                     (math-read-big-emptyp
  1047.                      h (1+ v) (1+ h) v2)
  1048.                     (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
  1049.                     (assoc (math-match-substring line 0)
  1050.                            math-standard-opers)))
  1051.               (and (>= (nth 2 widest) prec)
  1052.                (setq h (match-end 0)))
  1053.             (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
  1054.                   h))
  1055.              (setq widest '("2x" * 196 195)))))
  1056.     (cond ((eq (nth 3 widest) -1)
  1057.            (setq p (list (nth 1 widest) p)))
  1058.           ((equal (car widest) "?")
  1059.            (let ((y (math-read-big-rec h v1 h2 v2 baseline nil t)))
  1060.          (or (= (math-read-big-char the-h2 baseline) ?\:)
  1061.              (math-read-big-error the-h2 baseline "Expected `:'"))
  1062.          (setq p (list (nth 1 widest) p y
  1063.                    (math-read-big-rec (1+ the-h2) v1 h2 v2
  1064.                           baseline (nth 3 widest) t))
  1065.                h the-h2)))
  1066.           (t
  1067.            (setq p (list (nth 1 widest) p
  1068.                  (math-read-big-rec h v1 h2 v2
  1069.                         baseline (nth 3 widest) t))
  1070.              h the-h2))))
  1071.  
  1072.       ;; Return all relevant information to caller.
  1073.       (setq the-baseline baseline
  1074.         the-h2 h)
  1075.       (or short (= the-h2 h2)
  1076.       (math-read-big-error h baseline))
  1077.       p))
  1078. )
  1079.  
  1080. (defun math-read-big-char (h v)
  1081.   (or (and (>= h h1)
  1082.        (< h h2)
  1083.        (>= v v1)
  1084.        (< v v2)
  1085.        (let ((line (nth v lines)))
  1086.          (and line
  1087.           (< h (length line))
  1088.           (aref line h))))
  1089.       ?\ )
  1090. )
  1091.  
  1092. (defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
  1093.   (and (< ev1 v1) (setq ev1 v1))
  1094.   (and (< eh1 h1) (setq eh1 h1))
  1095.   (and (> ev2 v2) (setq ev2 v2))
  1096.   (and (> eh2 h2) (setq eh2 h2))
  1097.   (or what (setq what ?\ ))
  1098.   (let ((p (nthcdr ev1 lines))
  1099.     h)
  1100.     (while (and (< ev1 ev2)
  1101.         (progn
  1102.           (setq h (min eh2 (length (car p))))
  1103.           (while (and (>= (setq h (1- h)) eh1)
  1104.                   (= (aref (car p) h) what)))
  1105.           (and error (>= h eh1)
  1106.                (math-read-big-error h ev1 (if (stringp error)
  1107.                               error
  1108.                             "Whitespace expected")))
  1109.           (< h eh1)))
  1110.       (setq ev1 (1+ ev1)
  1111.         p (cdr p)))
  1112.     (>= ev1 ev2))
  1113. )
  1114.  
  1115. (defun math-read-big-error (h v &optional msg)
  1116.   (let ((pos 0)
  1117.     (p lines))
  1118.     (while (> v 0)
  1119.       (setq pos (+ pos 1 (length (car p)))
  1120.         p (cdr p)
  1121.         v (1- v)))
  1122.     (setq h (+ pos (min h (length (car p))))
  1123.       err-msg (list 'error h (or msg "Syntax error")))
  1124.     (throw 'syntax nil))
  1125. )
  1126.  
  1127. (defun math-read-big-balance (h v what &optional commas)
  1128.   (let* ((line (nth v lines))
  1129.      (len (min h2 (length line)))
  1130.      (count 1))
  1131.     (while (> count 0)
  1132.       (if (>= h len)
  1133.       (if what
  1134.           (math-read-big-error h1 v (format "Unmatched `%s'" what))
  1135.         (setq count 0))
  1136.     (if (memq (aref line h) '(?\( ?\[))
  1137.         (setq count (1+ count))
  1138.       (if (if (and commas (= count 1))
  1139.           (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
  1140.               (and (eq (aref line h) ?\.)
  1141.                (< (1+ h) len)
  1142.                (eq (aref line (1+ h)) ?\.)))
  1143.         (memq (aref line h) '(?\) ?\])))
  1144.           (setq count (1- count))))
  1145.     (setq h (1+ h))))
  1146.     h)
  1147. )
  1148.  
  1149.  
  1150.  
  1151.  
  1152.